home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / 4cmp22o.zip / HANOIMT.4TH < prev    next >
Text File  |  1994-08-13  |  9KB  |  331 lines
  1. \ This program is Copyright (C) 1987 by Thomas Almy.  All rights reserved.
  2.  
  3. \ This is an example program showing the operation of the multitasker.
  4. \ It solves the Tower of Hanoi Puzzle using multiple tasks rather than
  5. \ recursion or iteration!
  6.  
  7. \ The following options are appropriate on the ForthCMP command line:
  8. \  1 CONSTANT EGA        43 line EGA display (9 rings maximum)
  9. \  1 CONSTANT VGA        50 line VGA display (10 rings max, but ugly)
  10. \                               Default is 7 rings.
  11. \  I80186            80186 or later processor type
  12. \  1 CONSTANT VID-DELAY        IBM CGA (flicker problem)
  13.  
  14. 200 SEPSSEG
  15. 10000 100 MSDOSEXE
  16. NOMAP
  17.  
  18. FIND VGA #IF DROP -1 #ELSE 0 #THEN  \ Load the correct multitasker code
  19. FIND EGA #IF DROP -1 #ELSE 0 #THEN
  20. FIND VID-DELAY #IF DROP -1 #ELSE 0 #THEN
  21. OR OR #IF
  22. INCLUDE MULTID \ IBM COMPATIBLE ( direct to display ) screen driver
  23. #ELSE
  24. INCLUDE MULTI    \ Universal screen driver
  25. #THEN
  26. DECIMAL
  27.  
  28. FIND FOREGROUND #IF DROP #ELSE
  29. 1 0 IN/OUT
  30. : FOREGROUND DROP ( If not already defined, make into a noop ) ;
  31. #THEN
  32. FIND BACKGROUND #IF DROP #ELSE
  33. 1 0 IN/OUT
  34. : BACKGROUND DROP ( If not already defined, make into a noop ) ;
  35. #THEN
  36.  
  37. FIND l/s #IF DROP #ELSE 25 CONSTANT l/s #THEN    \ lines per screen
  38.  
  39. l/s 25 > CONSTANT BIGSCREEN? \ pack it in??
  40. l/s 43 > CONSTANT HUGESCREEN? \ really lots of room!
  41.  
  42. 1 1 IN/OUT
  43.  
  44. : 2** ( N -- 2**N )
  45.     1 SWAP 0 ?DO 2* LOOP ;
  46.  
  47. \ Offsets into HANOI messages
  48. ( offset zero is reserved for message pointer )
  49. 2 CONSTANT >INDX    \ Index into solution
  50. 4 CONSTANT >RING    \ ring number
  51. 6 CONSTANT >FROM    \ source ring
  52. 8 CONSTANT >TO        \ destination ring
  53. 10 CONSTANT >USE    \ temp ring
  54.  
  55. VARIABLE DCOUNT        \ extra taskswaps
  56.  
  57. 1 0 IN/OUT
  58. : SCRPOSITION ( index -- )
  59. \ put cursor to appropriate index position 
  60. BIGSCREEN? #IF
  61. HUGESCREEN? #IF
  62. \ there are 49 windows going down the screen and 26 windows across
  63.     0 l/s 1- UM/MOD 3 * SWAP GOTOXY ; ( position cursor )
  64. #ELSE
  65. \ there are 42 windows going down the screen and 13 windows across
  66.     0 l/s 1- UM/MOD 6 * SWAP GOTOXY ; ( position cursor )
  67. #THEN
  68. #ELSE
  69. \ there are 24 windows going down the screen, and seven windows across
  70.       0 l/s 1- UM/MOD 10 * SWAP GOTOXY ; ( position cursor )
  71. #THEN
  72.  
  73. VARIABLE DCOUNTER
  74.  
  75. 0 0 IN/OUT
  76. : MESSAGE-PRINT ( a task )
  77.     7 BACKGROUND
  78.     BEGIN
  79.     GET-MESSAGE >R        \ get message and save it
  80.     R@ >INDX @L SCRPOSITION    \ position cursor
  81.     R@ >RING @L 
  82.     DUP CASE 7 OF 15 ENDOF 8 OF 13 ENDOF 9 OF 12 ENDOF 10 OF 11 ENDOF
  83.         DUP ENDCASE FOREGROUND
  84. BIGSCREEN? #IF
  85. HUGESCREEN? NOT #IF
  86.     ASCII 0 + EMIT ASCII # EMIT
  87. #THEN
  88. #ELSE
  89.     ASCII # EMIT ASCII 0 + EMIT
  90.     SPACE
  91. #THEN
  92.     R@ >FROM @L EMIT
  93. BIGSCREEN? #IF
  94.     ASCII > EMIT
  95. #ELSE
  96.     ." ->"
  97. #THEN
  98.     R@ >TO @L EMIT
  99.     R> FREE            \ done with message
  100.     DCOUNT @ ?DUP IF \ wait a while??
  101.         DCOUNTER @ 1+ 7 AND DCOUNTER ! \ "randomize" the wait
  102.         DCOUNTER @ 8 + 12 */ 1+ WAIT 
  103.     THEN 
  104.     AGAIN 
  105.     ;
  106.  
  107.  
  108. \ Allocate 12 tasks to run the above word
  109.  
  110. ' MESSAGE-PRINT TASK  PRNT1
  111. ' MESSAGE-PRINT TASK  PRNT2
  112. ' MESSAGE-PRINT TASK  PRNT3
  113. ' MESSAGE-PRINT TASK  PRNT4
  114. ' MESSAGE-PRINT TASK  PRNT5
  115. ' MESSAGE-PRINT TASK  PRNT6
  116. ' MESSAGE-PRINT TASK  PRNT7
  117. ' MESSAGE-PRINT TASK  PRNT8
  118. ' MESSAGE-PRINT TASK  PRNT9
  119. ' MESSAGE-PRINT TASK  PRNT10
  120. ' MESSAGE-PRINT TASK  PRNT11
  121. ' MESSAGE-PRINT TASK  PRNT12
  122.  
  123.  
  124. TABLE DSPTBL-P PRNT1 , PRNT2 , PRNT3 , PRNT4 , PRNT5 , PRNT6 , PRNT7 , PRNT8 ,
  125.                PRNT9 , PRNT10 , PRNT11 , PRNT12 ,
  126. VARIABLE PINDEX        \ current index into dispatch table
  127.  
  128. VARIABLE PCOUNT        \ number of printer tasks to actually use
  129.  
  130. 0 1 IN/OUT
  131. : NEXT-PRINTER-TASK    ( -- task )
  132. \ gets address of the next printer task.
  133. \ What we are trying to do is have all eight tasks printing at once!
  134. \ This makes for one impressive display!
  135.     PINDEX @ DUP 1+ PCOUNT @ UMOD PINDEX ! \ count modulo PCOUNT
  136.     DSPTBL-P ;
  137.  
  138.  
  139. : MAKE-MESSAGE    ( index ring# from to using -- newMessage )
  140.     2 GET DUP >R  \ make a new message, 16 bytes long
  141.        >USE !L    \ store into all the fields
  142.     R@ >TO !L
  143.     R@ >FROM !L
  144.     R@ >RING !L
  145.     R@ >INDX !L
  146.     R> \ return message segment
  147.     ;
  148.  
  149.  
  150. 0 1 IN/OUT NEED NEXT-HANOI-TASK
  151.  
  152. 1 0 IN/OUT
  153. : SEND-MESSAGES ( ourMessage -- )
  154.     DUP >R         \ stash message on stack
  155.             \ calculate first message send
  156.        >INDX @L R@ >RING @L 1- 2** 2/ -  \ new index
  157.     R@ >RING @L 1-    \ new ring number
  158.     R@ >FROM @L     \ new from
  159.     R@ >USE  @L    \ new to
  160.     R@ >TO     @L    \ new use
  161.     MAKE-MESSAGE    \ create new message from this
  162.     NEXT-HANOI-TASK SEND-MESSAGE
  163.             \ calculate second message send
  164.     R@ >INDX @L R@ >RING @L 1- 2** 2/ +    \ new index
  165.     R@ >RING @L 1-    \ new ring number
  166.     R@ >USE  @L     \ new from
  167.     R@ >TO   @L     \ new to
  168.     R> >FROM @L     \ new use
  169.     MAKE-MESSAGE
  170.     NEXT-HANOI-TASK SEND-MESSAGE
  171.     ;
  172.  
  173. 0 0 IN/OUT
  174. : HANOI-TASK ( a task )
  175.     BEGIN
  176.         GET-MESSAGE         \ get next execution message
  177.     DUP >RING @L  1 > IF    \ high ring, send message to move lower rings
  178.         DUP SEND-MESSAGES THEN
  179.     NEXT-PRINTER-TASK SEND-MESSAGE    \ send our message on to printer task
  180.     AGAIN
  181.     ;
  182.  
  183. \ Allocate 6 tasks to run the above word
  184.  
  185. ' HANOI-TASK TASK HAN1
  186. ' HANOI-TASK TASK HAN2
  187. ' HANOI-TASK TASK HAN3
  188. ' HANOI-TASK TASK HAN4
  189. ' HANOI-TASK TASK HAN5
  190. ' HANOI-TASK TASK HAN6
  191.  
  192. TABLE DSPTBL-H  HAN1 , HAN2 , HAN3 , HAN4 , HAN5 , HAN6 ,
  193.  
  194. VARIABLE HINDEX        \ current index into dispatch table
  195.  
  196. VARIABLE HCOUNT        \ number of hanoi tasks to actually use
  197.  
  198.  
  199. 0 1 IN/OUT
  200. : NEXT-HANOI-TASK    ( -- task )
  201. \ gets address of the next HANOI task.
  202.     HINDEX @ DUP 1+ HCOUNT @ UMOD HINDEX ! \ count modulo HCOUNT
  203.     DSPTBL-H ;
  204.  
  205.  
  206. 0 1 IN/OUT 
  207. : WAITING-TASKS ( -- N )
  208.     0 MAIN-TASK
  209.     BEGIN
  210.         DUP WAITING? IF SWAP 1+ SWAP THEN
  211.     DUP 2+ CS: @ + 4 + \ addr of next task
  212.     DUP MAIN-TASK = UNTIL
  213.     DROP
  214. ;
  215.  
  216.  
  217. 1 1 IN/OUT
  218. : SETUP ( #rings -- message )
  219.     DUP 1- 2** 1- SWAP    \ got index and ring number
  220.     ASCII A            \ ring names
  221.     ASCII B
  222.     ASCII C
  223.     MAKE-MESSAGE ;
  224.  
  225.  
  226. 0 0 IN/OUT
  227. : RUN-DOWN \ execute until only main and TASKCOUNT are active
  228.     ACTIVE-TASKS 2 = IF EXIT THEN    \ nothing to wait for
  229.     0 l/s 1- GOTOXY 70 SPACES
  230.     0 l/s 1- GOTOXY ." waiting..." 
  231.     0
  232.     BEGIN  
  233.     ACTIVE-TASKS 2 > WHILE
  234.     1+ DUP 10 l/s 1- GOTOXY 6 U.R 
  235.     REPEAT
  236.     DROP
  237.     ;
  238.  
  239.  
  240. : GET-COMMAND  ( -- hcount pcount dcount ringcount  OR 0 )
  241. BIGSCREEN? #IF
  242. HUGESCREEN? #IF
  243.     0 l/s 1- GOTOXY ." NUMBER OF RINGS ( maximum is 10, default-QUIT):"
  244. #ELSE
  245.     0 l/s 1- GOTOXY ." NUMBER OF RINGS ( maximum is 9, default-QUIT):"
  246. #THEN
  247. #ELSE
  248.     0 l/s 1- GOTOXY ." NUMBER OF RINGS ( maximum is 7, default-QUIT):"
  249. #THEN
  250.     #IN 
  251.     DUP 0= IF 7 EMIT EXIT THEN
  252. BIGSCREEN? #IF
  253. HUGESCREEN? #IF
  254.     1 MAX 10 MIN
  255. #ELSE
  256.     1 MAX 9 MIN 
  257. #THEN
  258. #ELSE
  259.     1 MAX 7 MIN 
  260. #THEN
  261.     >R
  262.     0 l/s 1- GOTOXY 65 SPACES
  263.     0 l/s 1- GOTOXY ." NUMBER OF HANOI TASKS (1-6, default 6):"
  264.     #IN DUP 0= IF DROP 6 THEN 1 MAX 6 MIN 
  265.     0 l/s 1- GOTOXY 65 SPACES
  266.     0 l/s 1- GOTOXY ." NUMBER OF PRINTER TASKS (1-12, default 12):"
  267.     #IN DUP 0= IF DROP 12 THEN 1 MAX 12 MIN 
  268.     0 l/s 1- GOTOXY 65 SPACES
  269.     0 l/s 1- GOTOXY ." PRINTER TASK AVERAGE 18ms WAITS (max 50, default 0):"
  270.     #IN  50 MIN 0 MAX
  271.     R>
  272.     ;
  273.     
  274. VARIABLE MAXTASKS
  275. 0 0 IN/OUT
  276. : TASK-COUNTER ( a task )
  277.     1 BACKGROUND 
  278.     BEGIN
  279.         65 l/s 1- GOTOXY 
  280.     11 FOREGROUND WAITING-TASKS 7 .R
  281.     12 FOREGROUND ACTIVE-TASKS  DUP 3 .R 
  282.     10 FOREGROUND MAXTASKS @ MAX DUP MAXTASKS !  3 .R
  283.     5 WAIT ( about .1 sec updates )
  284.     AGAIN
  285.     ;
  286.  
  287. ' TASK-COUNTER TASK TASKCOUNT
  288.  
  289.  
  290. : MAIN
  291.     INIT-TASKS
  292.     7 BACKGROUND
  293.     14 FOREGROUND
  294.     CLS
  295.     ." MULTITASKING TOWER OF HANOI" CR
  296.     ." Copyright (C) 1987 by Thomas Almy.  All rights reserved." CR
  297.     ." This unmodified program may be distributed freely." CR
  298.     ." This program demonstrates the multitasking feature of ForthCMP," CR
  299.     ." the Forth language compiler" CR CR
  300.     ." The main task asks questions at the bottom of the display." CR
  301.     ." The tower puzzle is solved via message passing among a selectable number" CR
  302.     ." of tasks.  The printing of the moves is done be a selectable number of tasks." CR
  303.     ." The printer tasks can also have a variable amount of delay after each move." CR
  304.     ." The lower left corner of the display contains status information produced by" CR
  305.     ." a separate task 10 times per second.  The three numbers are:" CR
  306.     8 SPACES ." tasks waiting for timer" CR
  307.     8 SPACES ." tasks that are running" CR
  308.     8 SPACES ." total tasks used in last iteration" CR CR
  309.     ." Hitting Ctrl-Break will cause the program to abort and task status to be" CR
  310.     ." displayed."
  311. HUGESCREEN? #IF CR CR
  312.     ." The ring being moved is indicated by the color on the display."
  313. #THEN
  314.  
  315.     TASKCOUNT WAKE
  316.     BEGIN
  317.     GET-COMMAND
  318.     RUN-DOWN
  319.     ?DUP WHILE
  320.         MAXTASKS OFF
  321.     CLS 
  322.     >R DCOUNT ! PCOUNT ! HCOUNT ! 
  323.     R> SETUP NEXT-HANOI-TASK SEND-MESSAGE
  324.     REPEAT
  325.     BYE
  326.     ;
  327.  
  328. INCLUDE FARMEM2
  329. INCLUDE FORTHLIB
  330. END
  331.